perm filename S1.F4[TMP,LCS]1 blob
sn#130172 filedate 1974-11-08 generic text, type T, neo UTF8
00100 C THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
00200 C AT STANFORD UNIVERSITY. IT MAY NOT BE COPIED OR ALTERED IN ANY
00300 C WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.
00400
00500
00600 C 7/74 ********** SCORE ********** LELAND SMITH, SEP.1969
00700
00800 C THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND
00900 C GENERATION PROGRAM.
01000 C IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO' FORMAT.
01100 C LOAD 'SCORE' WITH BRZ.REL (RAN. NUM GENERATOR),SPRINT.MAC AND,
01200 C SCANW, (AND QUAD AND QUADO WHEN THEY ARE READY) AND
01300 C IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
01400 C SUBROUTINE SUBR
01500 C COMMON /INS/ INST(27),BG(60)
01600 C COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
01700 C INUM=INST# IPAR=PARAM#
01800 C BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
01900 C IF IREST IS <0, THAT NOTE WILL BE A REST.
02000 C INST=INST. NAME, BG=INSTS' BEGIN TIMES.
02100 C NOTE #S IN SUBROUTINE: (1-84) C4=37 FS4=43 C5=49 ETC.
02200 C F1=86 F15=100 (NO F16!)
02300
02400 COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT
02500 CC 7/74 COLGATE COMMON/TYP/ IS FOR COLTTY ROUT.
02600 COMMON/A/ ROFF(27),V(2000),NP(27),PCH(27,32),
02671 1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
02742 1 ,P1(27),JFM(4),COPY(30),IFM(80)
02884 1 ,FINM(6),TINST(5),TPALN(4),ENFI(5),TEDIT(4),INVIS(27)
02955 DIMENSION LIST(78),JNP(80)
03100 C WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY
03200 C 40 LIT CHARS + 30 PARAMS PER INST.
03300 C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
03400 COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
03500 1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
03600 1 ,INP(72),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
03620 COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,ITYP,INONLY,MX,
03640 1 Y,Z,ISLAC,MZ,LN,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
03660 1 ZZ,CHN,YY
03665 1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
03670 1 /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
03680 1 PARENS,JZ,BY,JED,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
03700 1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
03720 C /C/=26
03800 EQUIVALENCE (LIST,IFM(3)),(JNP,INP)
04500 DATA KZY/27/,ISEMI/';'/,IQT/'"'/
04600 1, JFM(3)/','/
04700 C IAA=A ID=D IE=E IF=F IEN=N IPP=P ISS=S ITT=T
04800 DATA KSLA/'/'/,IBLA/' '/,BLA/' '/,IXX/'X'/,ITMPO/'TEMPO'/
04900 1 ,ISCA/'C','P','D','N','E','F','PLAY;','G','S','A','T','B'/
05000 1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
06500 LPAR=0
06600 IPRN=0
06700 QX=0.
06800 MOT=0
06900 RETRO=-1.
07000 INVRT=-1
07050 ICON=-1
07100 LCNT=1
07200 PARENS=0
07300 JZ=1
07400 CALL RNDINT
07500 C INIT RAND NUM GENERATOR.
07600 CC PR=0
07700 IAMP=0
07800 C IAMP IS 'BLANK LINE'FLAG ON PP1-3.
07900 T5=0
08000 NINS=0
08100 K=0
08200 IDALL=-1
08300 QTS=-1.
08400 KB=0
08500 NWZ=1
08600 BNW(1)=0
08700 I=1
08800 KL=0
08900 TP=0
09000 KN=IBLA
09100 RA=0
09200 CHN=0
09300 DO 127 K=1,77,3
09400 127 LIST(K)=0
09500 C INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
09600 NWX=0
09700 BY=-1
09800 DO 1128 K=1,KZY
09900 INVIS(K)=0
10000 INST(K)=0
10100 CNT(K)=0
10200 RDEV(K)=0
10300 C RDEV IS FOR RAND DEVIATIONS AT RUN TIME
10400 NP(K)=0
10500 IQ(K)=0
10600 C IQ IS FOR RESTART FLAG
10700 IPT(K,1)=0
10800 DO 1128 L=1,32
10900 1128 PCH(K,L)=0
11000
11100 ITYP=-1
11200 C TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1),
11300 C SECONDS TO BE OMITTED, DUR AT CUTOFF.
11400 JED=-1
11500 2112 TYPE 8002
11600 1112 ACCEPT 77732,INP
11700 JFM(4)='5F)'
11800 JFM(1)=' (A'
11900 C FOR FREE 'A' FORMAT
12000 CALL FMT(JFM,INP,MLX)
12100 REREAD JFM,K,TF,AMPFAC,OP1,DURX
12200 C JFM IS THE CURRENT FORMAT STATEMENT
12300 IF(K.NE.'EDIT')GO TO 3112
12400 JED=0
12500 GO TO 2112
12600 C 'E(DIT)' GOES TO EDIT MODE
12700 3112 IF(TF.EQ.0)TF=1.
12800 IF(AMPFAC.EQ.0)AMPFAC=1.
12900 21122 IF(K.NE.'TYPE')GO TO 128
13000 ITYP=0
13100 DATA FINM/30H(' TYPE OUTPUT FILE NAME'/) /
13150 IFLNM='FOR21'
13200 CC*** 7/74 COLGATE TYPE FINM
13300 C TO USE TYPE-IN MODE. FILE OF INPUT IS WRITTEN ON FOR21.DAT
13400 CC** 7/74 COLGATE ACCEPT 1127,ISLAC
13500 CC*** 7/74 COLGATE IF(ISLAC.EQ.IBLA)STOP
13600 REWIND 21
13700 CC** 7/74 COLGATE WRITE (21,1127) ISLAC
13800 GO TO 3127
13900 11122 FORMAT(1XA5,72A1)
13910 77732 FORMAT(80A1)
13920 300 FORMAT(I,3F,A1)
14000 128 IF(K.NE.'INFO')GO TO 3128
14100 TYPE 8002
14200 TYPE 1113
14300 TYPE 118
14400 TYPE 1114
14500 TYPE 8002
14600 GO TO 1112
14700 118 FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22, PROOF=3, DEBUG=4'/)
14800 CC*** TEMPORARY ***8002 FORMAT(' TYPE FILE NAME'/)
14810 8002 FORMAT(' **** NEW VERSION ****',//' TYPE FILE NAME-- '$)
14900 8001 FORMAT(A5,5F)
15000 107 FORMAT(I,A5,5F)
15100 1113 FORMAT(' NAME, TF, AMPFAC, OMIT", DUR".'/)
15200 1114 FORMAT(' N1, N2=RAN NUM, N3=0 LISTS INPUT, N4=SINGLE INST.'/
15300 1 ' IF -- N1=3 DURS ONLY, =4 V ARRAY'/
15400 1 3X' 27 INSTRUMENTS ARE AVAILABLE'/)
15500 1127 FORMAT(A5,72A1)
15600 3128 IF(K.NE.IBLA)IFLNM=K
15700 CALL IFILE(1,IFLNM)
15790 CC*** 7/74 COLGATE READ(1,107)LN,ISLAC
15800 READ(1,107)LN,IXIN
15802 C CHECK FOR LINE NUMBERS ONLY.
15805 REWIND 1
15810 CALL IFILE(1,IFLNM)
15900 CC*** 7/74 REREAD 77732,JNP
16000 C FOR LATER USE
16100 CC** 7/74 IF(LN.NE.0)GO TO 3127
16200 C JUMP IF THE FILE HAS LINE NUMBERS.
16300 CC*** 7/74 REREAD 1127,ISLAC
16400 C REREADS FIRST LINE
16500
16610 3127 ISLAC=(IFLNM.AND."003777777777).OR."550000000000
16655 C MAGIC TO CHANGE LFT. LETTER TO Z(INP. ABCDE BECOMES ZBCDE.DAT)
16660 5127 TYPE 118
16700 IF(DURX.EQ.0)DURX=19999.
16800 IXIN=1
16900 CC -- NOW AT TOP OF PAGE 4(2/74) DO 1107 K=1,30
17000 CC1107 PL(K)=1.
17100 INONLY=-1
17200 ACCEPT 300,MX,X,Y,Z
17210 IF(MX.NE.99)GO TO 6127
17220 TYPE FINM
17230 ACCEPT 1127,ISLAC
17240 GO TO 5127
17300 6127 IF(Z.NE.0)INONLY=Z
17400 IF(X.NE.0)IXIN=X
17500 C MX=3 GIVES DURS ONLY
17600 C TO SUPPRESS LIST OF INPUT DATA, TYPE ANY 3RD NUM. (BUT 9.)
17700 C (1 1 1 =RECORD,RAN. NUM=1,SUPPRESS INPUT.)
17800 MZ=0
17900 JOUT=5
18000 C 5=OUTPUT TO TTY
18100 SOS=-1.
18200 IF(Y.NE.0)SOS=0
18300 C IF 3RD NUM≠0, EDIT FILE WILL PRINT AS IT IS READ.
18400 IF(MX.NE.22)GO TO 2107
18500 JOUT=3
18600 C DIRECT TO LPT AT COLGATE 6/74
18700 CC JOUT=22
18800 CC REWIND 22
18900 2107 IF(MX.LE.1)MX=MX-2
19000 IF(MX.EQ.-2.OR.MX.EQ.2.OR.MX.EQ.22)MZ=-1
19100 IF(MX.EQ.4)MZ=-4
19200 CC IF(SOS.AND.ITYP)WRITE(JOUT,87732)INP
19300 CC*** 7/74 COLGATE IF(SOS.AND.ITYP)CALL COLTTY(JNP,JOUT,3)
19320 CALL READIT
19360 END